# $Id: Menu.pm,v 1.4 2004/06/21 12:12:30 ibo Exp $
package CGI::FOGE2::Menu;

use strict;
use CGI::FOGE2::Tools;

our @ISA = qw(CGI::FOGE2::Question);

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;

    my %args = @_;
    my @mandatory_keys = ('title', 'items', 'id');
    my $self =
      {
       id            => undef,  # autogen (?)
       default       => undef,	# the default item (was: initial)
       items         => undef,  # an array of items (was: choice)
       title         => undef,	# was: label
       ismandatory   => 0,
########### BRICOLAGE ###########
       ismultiple    => 0,
#################################
       isvalidregexp => undef,
       validate      => undef, # func. returning string or false
       stats         => [CGI::FOGE2::StatsSimple->new()],
      };

    bless ($self, $class);
    $self->_construct(\%args, \@mandatory_keys);
    return $self;
}

####### BRICOLAGE #############
sub suitable_stats {
    my $self = shift;
    my %stat_constructors = ('StatsPiechart' => sub {CGI::FOGE2::StatsPiechart->new()},
			     'StatsSimple' => sub {CGI::FOGE2::StatsSimple->new()},
			     'StatsDouble' => sub {CGI::FOGE2::StatsDouble->new()},
			     );
    return \%stat_constructors;
}
###############################

sub serve {
    my $self = shift;

    my $id = $self->{id};
    my $names = $self->generate_field_names();
    my $name = $names->[0];

    my @items = @{$self->{items}};
    unshift @items, theform->get_bof();

    my %line = (-values => \@items,
		-name => $name,
		);

    if ($self->{ismultiple}) {
	$line{-multiple} = 1;
    }

    if (defined $self->{default}) {
	$line{-default} = $self->{default};
    }

    return table3cols($self->{title},
		      $self->{ismandatory},
		      CGI::popup_menu(%line));
}

sub as_text {
    my $self = shift;
    my ($ign, $indent) = @_;
    my $out = $self->as_text_header(@_);
    
    my $header = '    Menu (0..*): ';
    my $headb  = ' ' x length $header;
    my $fmt = $indent . "%s%s\n";

    my @items = @{$self->{items}};

    $out .= sprintf $fmt, $header, shift @items || '<undef>';
    foreach (@items) {
	$out .= sprintf $fmt, $headb, $_;
    }
    return $out;
}

# Sort the result of stats->computedata() along the order suggested by
# the items of the question. Code similar to RadioButton.pm

sub sort {
    my $self = shift;
    my ($number, $total, $names, $vals) = @_;
    my (@new_names, @new_vals);
    my (@lost_names, @lost_vals);
    N: 
    for ( my $i=0 ; $i<@{$names} ; $i++ ) {
        for ( my $j=0 ; $j<@{$self->{items}} ; $j++ ) {
            if ( $self->{items}->[$j] eq $names->[$i] ) {
                $new_names[$j] = $names->[$i];
                $new_vals[$j] = $vals->[$i];
                next N;
            };
        }
        push @lost_names, $names->[$i];
        push @lost_vals, $vals->[$i];
    }
    return ($number, $total, 
            [@new_names, @lost_names], 
            [@new_vals, @lost_vals] );
}

1;

# end of Menu.pm
